home *** CD-ROM | disk | FTP | other *** search
/ Aminet 15 / Aminet 15 - Nov 1996.iso / Aminet / dev / basic / ace24dist.lha / ace24.lha / prgs / Fractals / triscape.b < prev   
Text File  |  1996-09-10  |  9KB  |  403 lines
  1. { Fractal landscapes.
  2.  
  3.   Author: David J Benn
  4.     Date: 28th,29th August 1993
  5.  
  6.   I'd like to thank Paul McGuire for his MS-DOS program: FRMESH. I 
  7.   experimented with FRMESH and used the accompanying documentation 
  8.   when creating this program.
  9.  
  10.   Note: there seems to be a flaw in my algorithm which produces 
  11.   gaps in between triangles sometimes. Am I not taking into account
  12.   all new sub-triangles?
  13.  
  14.   The vertices A-F cited in this program are based upon the
  15.   following hypothetical equilateral triangle:
  16.  
  17.                 A
  18.                /\
  19.               /  \
  20.             D/____\E
  21.             /\    /\
  22.            /  \  /  \
  23.           /    \/    \
  24.          B------------C     
  25.             F
  26.  
  27.   Usage: (shell/CLI (type "triscape ?") or Workbench)
  28.   -----
  29.  
  30.   1. Select three points on screen with mouse to create a triangle.
  31.   2. Press left mouse button for next generation. 
  32. }
  33.  
  34. deflng a-z
  35.  
  36. const nil=0&, true=-1&, false=0&
  37. const none=0, continue=1, quit=2
  38. const PUBLIC=2
  39. const aspect=.85
  40.  
  41. SINGLE distortion
  42. distortion = .2        '..(20%)
  43.  
  44. STRUCT triangle_node
  45.   SHORTINT x1
  46.   SHORTINT y1
  47.   SHORTINT x2
  48.   SHORTINT y2
  49.   SHORTINT x3
  50.   SHORTINT y3
  51.   ADDRESS  nxt
  52. END STRUCT
  53.  
  54. DECLARE STRUCT triangle_node *T, *tri
  55.  
  56. SUB in_CLI
  57. external stdout&
  58.   if stdout<>0& then 
  59.     in_CLI=true
  60.   else
  61.     in_CLI=false
  62.   end if
  63. END SUB
  64.  
  65. SUB pause
  66.   time0=timer
  67.   while timer < time0+0.1:wend
  68. END SUB
  69.  
  70. SUB get_point(ADDRESS x, ADDRESS y)
  71.   '..await left mouse button press
  72.   while not mouse(0):wend
  73.   '..get values
  74.   *%x := mouse(1)
  75.   *%y := mouse(2)
  76.   line (*%x-3,*%y-3)-(*%x+3,*%y+3),2,b 
  77.   '..await left mouse button release
  78.   pause
  79.   while mouse(0):wend
  80. END SUB
  81.  
  82. SUB choice
  83.   response=none
  84.   repeat
  85.     k$=ucase$(inkey$)
  86.     if k$="Q" then response=quit
  87.     if k$="C" then response=continue
  88.   until response<>none
  89.   choice = response
  90. END SUB
  91.  
  92. SUB line_length(x1,y1,x2,y2)
  93.   '..find two sides of the right angled triangle
  94.   '..with (x1,y1)-(x2,y2) as its hypotenuse.
  95.   t_rise = abs(y2-y1)
  96.   t_run = abs(x2-x1)
  97.   '..find length via Pythagoras' Theorem
  98.   '..(a^2 = b^2 + c^2).
  99.   line_length = SQR(t_rise*t_rise + t_run*t_run) 
  100. END SUB
  101.  
  102. SUB max_length(ab,ac,bc,ADDRESS side_addr)
  103. STRING side ADDRESS side_addr
  104.   max = ab : side = "ab"
  105.   if ac > max then max = ac : side = "ac"
  106.   if bc > max then max = bc : side = "bc"
  107.   max_length = max
  108. END SUB
  109.  
  110. SUB show_triangle(ADDRESS T)
  111. DECLARE STRUCT triangle_node *tri
  112. SHORTINT colr
  113. STRING side
  114.  
  115.   '..Display triangle filled with
  116.   '..shade of gray corresponding to
  117.   '..area of triangle. As triangle
  118.   '..becomes smaller, shade becomes
  119.   '..darker. 
  120.  
  121.   tri = T
  122.  
  123.   '..find area of triangle
  124.   '..store vertices
  125.   x1=tri->x1
  126.   y1=tri->y1
  127.   x2=tri->x2
  128.   y2=tri->y2
  129.   x3=tri->x3
  130.   y3=tri->y3
  131.   '..find length of each side
  132.   ab_len = line_length(x1,y1,x2,y2)
  133.   ac_len = line_length(x1,y1,x3,y3)
  134.   bc_len = line_length(x2,y2,x3,y3)
  135.   '..base is longest side
  136.   t_base = max_length(ab_len,ac_len,bc_len,@side)
  137.   '..find height    
  138.   case
  139.     side = "ab" : height = abs(y3-y1)
  140.     side = "ac" : height = abs(y2-y3)
  141.     side = "bc" : height = abs(y1-y2)
  142.   end case
  143.   '..calculate area
  144.   t_area = .5 * t_base * height
  145.  
  146.   '..determine color on basis of area 
  147.   '..(the smaller, the darker)
  148.   case 
  149.     t_area > 1000 : colr = 0
  150.     t_area > 500  : colr = 1
  151.     t_area > 200  : colr = 2
  152.     t_area > 100  : colr = 3
  153.     t_area > 50   : colr = 4
  154.     t_area > 25   : colr = 5
  155.     t_area > 10   : colr = 6
  156.     t_area <= 10  : colr = 7
  157.   end case
  158.   
  159.   '..draw filled triangle
  160.   AREA (x1,y1)
  161.   AREA (x2,y2)
  162.   AREA (x3,y3)
  163.   AREA (x1,y1)
  164.   COLOR colr+5
  165.   AREAFILL
  166.  
  167.   '..show triangle's borders 
  168.   line (x1,y1)-(x2,y2),1
  169.   line (x2,y2)-(x3,y3),1
  170.   line (x3,y3)-(x1,y1),1
  171. END SUB
  172.  
  173. SUB rnd_sign
  174.   if rnd < .5 then
  175.     rnd_sign = -1!
  176.   else
  177.     rnd_sign = 1!
  178.   end if
  179. END SUB
  180.  
  181. SUB next_generation(ADDRESS T, SINGLE distortion)
  182. DECLARE STRUCT triangle_node *tri, *new_tri
  183. DIM a(2),b(2),c(2),d(2),e(2),f(2)
  184. ADDRESS nxt_tri
  185.  
  186.   '..derive four new triangles from each 
  187.   '..single triangle in the list.
  188.   
  189.   CLS
  190.  
  191.   color 3
  192.   locate 26,35
  193.   prints "Generating"
  194.   color 2
  195.   locate 28,25
  196.   prints "press left mouse button to stop"
  197.  
  198.   ON MOUSE goto quit
  199.   MOUSE ON
  200.  
  201.   tri = T
  202.  
  203.   WHILE tri <> nil
  204.     '..next node in list
  205.     nxt_tri = tri->nxt    
  206.  
  207.     '..vertices of triangle
  208.     a(1) = tri->x1
  209.     a(2) = tri->y1
  210.     b(1) = tri->x2
  211.     b(2) = tri->y2  
  212.     c(1) = tri->x3
  213.     c(2) = tri->y3  
  214.  
  215.     '..find length of each side of current triangle.
  216.     abx_len = abs(tri->x1 - tri->x2)
  217.     aby_len = abs(tri->y1 - tri->y2)    '..ab
  218.     acx_len = abs(tri->x1 - tri->x3)
  219.     acy_len = abs(tri->y1 - tri->y3)    '..ac
  220.     bcx_len = abs(tri->x2 - tri->x3)
  221.     bcy_len = abs(tri->y2 - tri->y3)    '..bc
  222.  
  223.     '..find midpoints of each side of current triangle.
  224.     abx = (tri->x1 + tri->x2) \ 2
  225.     aby = (tri->y1 + tri->y2) \ 2    '..ab
  226.     acx = (tri->x1 + tri->x3) \ 2    
  227.     acy = (tri->y1 + tri->y3) \ 2    '..ac
  228.     bcx = (tri->x2 + tri->x3) \ 2
  229.     bcy = (tri->y2 + tri->y3) \ 2    '..bc
  230.  
  231.     '..add a small +/- displacement to midpoint values.
  232.     d(1) = abx + (rnd * distortion*abx_len * rnd_sign)
  233.     d(2) = aby + (rnd * distortion*aby_len * rnd_sign) * aspect
  234.     e(1) = acx + (rnd * distortion*acx_len * rnd_sign)
  235.     e(2) = acy + (rnd * distortion*acy_len * rnd_sign) * aspect
  236.     f(1) = bcx + (rnd * distortion*bcx_len * rnd_sign)
  237.     f(2) = bcy + (rnd * distortion*bcy_len * rnd_sign) * aspect
  238.  
  239.     '..triangle 1.0 = ade
  240.     tri->x1 = a(1)
  241.     tri->y1 = a(2)
  242.     tri->x2 = d(1)
  243.     tri->y2 = d(2)
  244.     tri->x3 = e(1)
  245.     tri->y3 = e(2)
  246.     
  247.     '..triangle 1.1 = dbf
  248.     new_tri = ALLOC(sizeof(triangle_node), PUBLIC)
  249.     if new_tri = nil then next_generation=true:beep:exit sub
  250.     tri->nxt = new_tri
  251.     tri = tri->nxt
  252.     tri->x1 = d(1)
  253.     tri->y1 = d(2)
  254.     tri->x2 = b(1)
  255.     tri->y2 = b(2)
  256.     tri->x3 = f(1)
  257.     tri->y3 = f(2)
  258.  
  259.     '..triangle 1.2 = dfe
  260.     new_tri = ALLOC(sizeof(triangle_node), PUBLIC)
  261.     if new_tri = nil then next_generation=true:beep:exit sub
  262.     tri->nxt = new_tri
  263.     tri = tri->nxt
  264.     tri->x1 = d(1)
  265.     tri->y1 = d(2)
  266.     tri->x2 = f(1)
  267.     tri->y2 = f(2)
  268.     tri->x3 = e(1)
  269.     tri->y3 = e(2)
  270.  
  271.     '..triangle 1.3 = efc
  272.     new_tri = ALLOC(sizeof(triangle_node), PUBLIC)
  273.     if new_tri = nil then next_generation=true:beep:exit sub
  274.     tri->nxt = new_tri
  275.     tri = tri->nxt
  276.     tri->x1 = e(1)
  277.     tri->y1 = e(2)
  278.     tri->x2 = f(1)
  279.     tri->y2 = f(2)
  280.     tri->x3 = c(1)
  281.     tri->y3 = c(2)
  282.     
  283.     '..point to next triangle in list
  284.     tri->nxt = nxt_tri 
  285.     tri = tri->nxt
  286.   WEND
  287.  
  288.   MOUSE OFF
  289.  
  290.   '..There was enough memory to
  291.   '..create the next generation
  292.   '..if we got this far (false = not finished! -- see main loop below).
  293.   next_generation = false
  294. END SUB
  295.  
  296.  
  297. { ** MAIN ** }
  298.  
  299. RANDOMIZE TIMER
  300.  
  301. '..CLI argument?
  302. if argcount=1 then 
  303.   if arg$(1) = "?" then 
  304.     print "usage: ";arg$(0);" [distortion]"
  305.     print "   eg: ";arg$(0);" .1"
  306.     STOP
  307.   else
  308.     distortion = val(arg$(1))
  309.   end if
  310. end if
  311.  
  312. screen 1,640,425,4,4
  313.  
  314. font "topaz",8
  315.  
  316. palette 0,0,0,0        '..black
  317. palette 1,1,1,1        '..white
  318. palette 2,0,1,0        '..green
  319. palette 3,1,0,0        '..red
  320. palette 4,1,1,.13    '..yellow
  321. palette 5,.93,.93,.93    '..gray 0 (light)
  322. palette 6,.83,.83,.83    '..gray 1
  323. palette 7,.73,.73,.73    '..gray 2
  324. palette 8,.63,.63,.63    '..gray 3
  325. palette 9,.53,.53,.53    '..gray 4
  326. palette 10,.43,.43,.43    '..gray 5
  327. palette 11,.33,.33,.33    '..gray 6
  328. palette 12,.23,.23,.23    '..gray 7 (dark)
  329.  
  330. '..Create and display landscapes until user quits or memory runs out.
  331.  
  332. REPEAT
  333.   '..create first node of list
  334.   T = ALLOC(sizeof(triangle_node), PUBLIC)
  335.   if T = nil then 
  336.     screen close 1
  337.     beep
  338.     STOP
  339.   else
  340.     T->nxt = nil
  341.   end if
  342.  
  343.   '..select three points
  344.   CLS
  345.   color 4
  346.   locate 30,27
  347.   prints "Select 3 points with mouse"
  348.   get_point(@T->x1,@T->y1)  
  349.   get_point(@T->x2,@T->y2)  
  350.   get_point(@T->x3,@T->y3)  
  351.  
  352.   '..Create and display successive generations of triangles
  353.   '..until user quits or no more memory can be allocated for 
  354.   '..triangle list.
  355.  
  356.   finished=false
  357.  
  358.   REPEAT
  359.     CLS
  360.     color 1
  361.     locate 44,1
  362.     prints "Distortion:";
  363.     color 4
  364.     prints str$(distortion*100);"%"
  365.  
  366.     '..show current generation.
  367.     tri = T
  368.     WHILE tri <> nil
  369.       show_triangle(tri)
  370.       tri = tri->nxt
  371.     WEND
  372.  
  373.     color 2
  374.     locate 46,1
  375.     prints "C to continue."
  376.     color 3
  377.     locate 48,1
  378.     prints "Q to quit."
  379.   
  380.     '..continue?
  381.     opt = choice
  382.     if opt = continue then 
  383.       finished = next_generation(T, distortion)    
  384.     else    
  385.       finished = true
  386.     end if
  387.   UNTIL finished
  388.  
  389.   QUIT:
  390.     color 4
  391.     locate 48,1
  392.     prints "Q to quit program. R to restart."
  393.     repeat
  394.       k$ = ucase$(inkey$)
  395.     until k$="Q" or k$="R"
  396.     if k$="Q" then want_to_quit=true else want_to_quit=false
  397. UNTIL want_to_quit
  398.  
  399. screen close 1
  400.  
  401. '..Memory allocated by ALLOC is freed at end of program run.
  402. if in_CLI<>nil then print "Freeing allocated memory."
  403.